home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-11-18 | 44.3 KB | 1,532 lines | [TEXT/MPS ] |
- {------------------------------------------------------------------------------
- #
- # Apple Macintosh Developer Technical Support
- #
- # Offscreen Buffer Sample Application
- #
- # OffSample
- #
- # OffSample.p - Pascal Source
- #
- # Copyright © 1989 Apple Computer, Inc.
- # All rights reserved.
- #
- # Versions:
- # 1.00 04/89
- # 1.01 06/92
- #
- # Components:
- # OffSample.p April 1, 1989
- # OffSample.r April 1, 1989
- # OffSample.h April 1, 1989
- # OffSample.rsrc April 1, 1989
- # POffSample.make April 1, 1989
- #
- # Requirements:
- # Offscreen.p April 1, 1989
- # Offscreen.inc1.p April 1, 1989
- # UFailure.p November 1, 1988
- # UFailure.inc1.p November 1, 1988
- # UFailure.a November 1, 1988
- #
- # OffSample demonstrates the usage of the Offscreen
- # unit. It shows how to use offscreen pixmaps and
- # bitmaps to produce flicker-free updating with a
- # minimum of re-structuring of code. OffSample attempts
- # to reduce the amount of 'knowledge' that it has of
- # the offscreen structure so as to minimize its
- # dependence on that unit.
- #
- # OffSample emphasizes using the Offscreen unit; it
- # is not intended to be viewed as a complete application
- # from which to base some larger effort. Instead, its
- # method of using offscreen bitmaps and pixmaps should
- # be studied and adapted to other applications that
- # desire features such as flicker-free updating.
- #
- ------------------------------------------------------------------------------}
-
-
- PROGRAM OffSample;
-
- USES
- Types, QuickDraw, Palettes, Events, Controls, Windows, TextEdit, Dialogs,
- Fonts, Lists, Menus, Resources, Scrap, ToolUtils,
- OSUtils, Files, Devices, DeskBus, DiskInit, Disks, Errors, Memory, Retrace, SegLoad, Serial,
- ShutDown, Slots, Sound, Start, Timer,
- Packages, ColorPicker, UFailure, Offscreen, Traps;
-
- CONST
-
- kSysEnvironsVersion = 1;
-
- kOSEvent = app4Evt; {event used by MultiFinder}
- kSuspendResumeMessage = 1; {high byte of suspend/resume event message}
- kResumeMask = 1; {bit of msg field for resume vs. suspend}
-
- kMinHeap = 66 * 1024;
-
- kMinSpace = 49 * 1024;
-
- kExtremeNeg = -32768;
- kExtremePos = 32767 - 1; {required for old region bug}
-
- sErrStrings = 128; {error string STR#}
- eStandardErr = 1;
- eWrongMachine = 2;
- eSmallSize = 3;
- eNoMemory = 4;
-
- kNoBackBuff = 128;
- kNoEditBuff = 129;
- kTitle = 130;
- kColorPrompt = 131;
- kNoWantBack = 132;
- kNoWantEdit = 133;
-
- kCMoof = 128;
- kGigantor = 128;
- k1bitGigantor = 129;
-
- rMenuBar = 128; {application's menu bar}
- rAboutAlert = 128; {about alert}
- rUserAlert = 129; {error user alert}
- rWindow = 128; {application's window}
-
- mApple = 128; {Apple menu}
- iAbout = 1;
-
- mFile = 129; {File menu}
- iNew = 1;
- iClose = 4;
- iQuit = 12;
-
- mEdit = 130; {Edit menu}
- iUndo = 1;
- iCut = 3;
- iCopy = 4;
- iPaste = 5;
- iClear = 6;
-
- mShape = 131; {Shape menu}
-
- mSpecial = 132; {Special menu}
- iUseBack = 1;
- iUseEdit = 2;
- iPickColor = 4;
-
- kDITop = $0050;
- kDILeft = $0070;
-
- kNotDrawn = -1;
- kLastOne = -2;
-
- kCursorDepth = 2;
- kMemoryPolite = TRUE;
-
- kFramePenH = 2;
- kFramePenV = 2;
-
-
- TYPE
-
- Shapes = (kOval, kRegion, kRRect, kPoly, kRect, kICON, kPICT);
-
- ShapeRecord = RECORD
- next : Shapes; {when is it drawn?}
- extent : Rect; {where is it?}
- END;
-
- ShapeArray = ARRAY [Shapes] OF ShapeRecord;
-
- {An OffscreenRecord contains the WindowRecord for one of our sample windows,
- as well as an offscreen handle for the background and an offscreen handle
- for the background plus the shape being created. It also has an array of
- shapes for this window, a pointer to the first shape, a pointer to the
- shape being edited, and a record of the last state of the buffers. For a
- similar example of extending a toolbox data structure, see how the Window
- Manager and Dialog Manager add fields to the GrafPort and WindowRecord,
- respectively.}
-
- OffscreenRecord = RECORD
- fWindow : WindowRecord; {window data structure for toolbox use}
- fBackHandle : Handle; {offscreen pixmap that holds background}
- fEditHandle : Handle; {pixmap for background and shape being created}
- fShapes : ShapeArray; {the shapes for this window}
- fFirst : Shapes; {who is first?}
- fEdit : Shapes; {who is being edited?}
- fHasBack : BOOLEAN; {did it have a background buffer last time?}
- fHasEdit : BOOLEAN; {did it have a edit buffer last time?}
- END;
- OffscreenPeek = ^OffscreenRecord;
-
-
- VAR
- {The "g" prefix is used to emphasize that a variable is global.}
-
- gMac : SysEnvRec; {set up by Initialize}
- gHasWaitNextEvent : BOOLEAN; {set up by Initialize}
- gInBackground : BOOLEAN; {maintained by Initialize and DoEvent}
-
- gShape : Shapes; {current shape}
- gUseBack : BOOLEAN; {create background offscreen flag}
- gUseEdit : BOOLEAN; {create edit offscreen flag}
- gCursor : CCrsrHandle; {there can be ONLY one}
- gOughHandle : Handle; {offscreen handle for color cursor}
- gPICT : PicHandle; {Gigantor}
- gcicn : CIconHandle; {Moof!™}
- g1BitHandle : Handle; {for the color cursor mask}
-
-
- {$S Initialize}
- FUNCTION TrapAvailable(tNumber: INTEGER; tType: TrapType): BOOLEAN;
-
- {Check to see if a given trap is implemented. This is only used by the
- Initialize routine in this program, so we put it in the Initialize segment.
- The recommended approach to see if a trap is implemented is to see if
- the address of the trap routine is the same as the address of the
- Unimplemented trap. Needs to be called after call to SysEnvirons so that
- it can check if a ToolTrap is out of range of a pre-MacII ROM.}
-
- BEGIN
- IF (tType = ToolTrap) &
- (gMac.machineType > envMachUnknown) &
- (gMac.machineType < envMacII) THEN BEGIN {it's a 512KE, Plus, or SE}
- tNumber := BAND(tNumber, $03FF);
- IF tNumber > $01FF THEN {which means the tool traps}
- tNumber := _Unimplemented; {only go to $01FF}
- END;
- TrapAvailable := NGetTrapAddress(tNumber, tType) <>
- NGetTrapAddress(_Unimplemented, ToolTrap);
- END; {TrapAvailable}
-
-
- {$S Main}
- PROCEDURE GetGlobalRect (window: WindowPtr; VAR globalRect: Rect);
-
- {Return the portRect of window in global coordinates.}
-
- VAR
- savePort : GrafPtr;
-
- BEGIN
- GetPort(savePort);
- SetPort(window); {so that the correct }
- globalRect := window^.portRect; { coordinate system is used}
- WITH globalRect DO BEGIN
- LocalToGlobal(topLeft);
- LocalToGlobal(botRight);
- END;
- SetPort(savePort);
- END; {GetGlobalRect}
-
-
- {$S Main}
- FUNCTION IsDAWindow (window: WindowPtr): BOOLEAN;
-
- {Check if a window belongs to a desk accessory.}
-
- BEGIN
- IF window = NIL THEN
- IsDAWindow := FALSE
- ELSE {DA windows have negative windowKinds}
- IsDAWindow := WindowPeek(window)^.windowKind < 0;
- END; {IsDAWindow}
-
-
- {$S Main}
- FUNCTION IsAppWindow (window: WindowPtr): BOOLEAN;
-
- {Check to see if a window belongs to the application. If the window pointer
- passed was NIL, then it could not be an application window. WindowKinds
- that are negative belong to the system and windowKinds less than userKind
- are reserved by Apple except for windowKinds equal to dialogKind, which
- mean it is a dialog.}
-
- BEGIN
- IF window = NIL THEN
- IsAppWindow := FALSE
- ELSE {application windows have windowKinds >= userKind (8)}
- WITH WindowPeek(window)^ DO
- IsAppWindow := (windowKind = userKind);
- END; {IsAppWindow}
-
-
- {$S Main}
- PROCEDURE FailNILMsg(p: UNIV Ptr; message: INTEGER);
-
- {Check for NIL p and fail if so.}
-
- BEGIN
- IF p = NIL THEN
- Failure(memFullErr, message);
- END; {FailNILMsg}
-
-
- {$S Main}
- PROCEDURE AlertUser(error: INTEGER; message: LongInt);
-
- {Display an alert to inform the user of an error. Message acts as an
- index into a STR# resource of error messages. If no message is given,
- i.e. = 0, then use a standard message. If error is not noErr then
- display it as well.}
-
- VAR
- msg1, msg2 : Str255;
- itemHit : INTEGER;
- BEGIN
- IF message = 0 THEN message := eStandardErr;
- GetIndString(msg1, sErrStrings, message);
- IF error = noErr THEN
- msg2 := ''
- ELSE
- NumToString(error, msg2);
- ParamText(msg1, msg2, '', '');
- itemHit := Alert(rUserAlert, NIL);
- END; {AlertUser}
-
-
- {$S Main}
- FUNCTION DoCloseWindow(window: WindowPtr) : BOOLEAN;
-
- {Close a window.}
-
- {At this point, if there was a document associated with a
- window, you could do any document saving processing if it is 'dirty'.
- DoCloseWindow would return TRUE if the window actually closes, i.e.,
- the user does not cancel from a save dialog. This result is handy when
- the user quits an application, but then cancels a save of a document
- associated with a window. We also added code to close the application
- window since otherwise, the termination routines would never stop looping,
- waiting for FrontWindow to return NIL.}
-
- VAR
- pal : PaletteHandle;
-
- BEGIN
- DoCloseWindow := TRUE;
- IF IsDAWindow(window) THEN
- CloseDeskAcc(WindowPeek(window)^.windowKind);
- IF IsAppWindow(window) THEN BEGIN
- WITH OffscreenPeek(window)^ DO BEGIN
- DisposeOffscreen(fBackHandle);
- DisposeOffscreen(fEditHandle);
- END;
- IF gMac.hasColorQD THEN BEGIN
- pal := GetPalette(window); {We must handle this ourselves,}
- DisposePalette(pal); {since we may have done a GetPalette.}
- END;
- CloseWindow(window); {Since we provided our own storage.}
- DisposePtr(Ptr(window));
- END;
- END; {DoCloseWindow}
-
-
- {$S Main}
- PROCEDURE EfficientConcat2 (VAR string1, string2: Str255);
-
- {Do a more efficient concat than CONCAT since we know
- there are only two strings.}
-
- VAR
- len1, len2 : INTEGER;
-
- BEGIN
- len1 := LENGTH(string1);
- IF len1 < 255 THEN BEGIN
- len2 := LENGTH(string2);
- IF len1 + len2 > 255 THEN
- len2 := 255 - len1;
- BlockMove(@string2[1], @string1[1 + len1], len2);
- string1[0] := CHR(len1 + len2);
- END;
- END; {EfficientConcat2}
-
-
- {$S Main}
- PROCEDURE AppendTitle (VAR title: Str255; id: INTEGER);
-
- {Append the specified string resource data to the provided
- string.}
-
-
- VAR
- aString : StringHandle;
-
- BEGIN
- aString := GetString(id);
- IF aString <> NIL THEN BEGIN
- HLock(Handle(aString)); {in case EfficientConcat2 is}
- EfficientConcat2(title, aString^^);
- HUnlock(Handle(aString)); {in a different segment}
- END;
- END; {AppendTitle}
-
-
- {$S Main}
- PROCEDURE CheckTitle (window: WindowPtr; doCheck: BOOLEAN);
-
- {Compare the prior state of the offscreen handles for
- window and change its title to reflect the new state.}
-
- VAR
- aString : StringHandle;
- title : Str255;
- hasBack, hasEdit : BOOLEAN;
-
- BEGIN
- IF IsAppWindow(window) THEN
- WITH OffscreenPeek(window)^ DO BEGIN
- hasBack := (GetMap(fBackHandle) <> NIL);
- hasEdit := (GetMap(fEditHandle) <> NIL);
- IF (NOT doCheck) | {set title regardless}
- (fHasBack <> hasBack) | {or if change}
- (fHasEdit <> hasEdit) THEN BEGIN {in buffers}
- fHasBack := hasBack;
- fHasEdit := hasEdit;
- title := '';
- aString := GetString(kTitle);
- IF aString <> NIL THEN
- title := aString^^;
-
- {If an offscreen handle is NIL, it means
- that the creation of that offscreen handle
- was disabled by the user. Once that is
- done, the buffer will never be created.}
-
- IF fBackHandle = NIL THEN
- AppendTitle(title, kNoWantBack)
- ELSE IF NOT hasBack THEN
- AppendTitle(title, kNoBackBuff);
- IF fEditHandle = NIL THEN
- AppendTitle(title, kNoWantEdit)
- ELSE IF NOT hasEdit THEN
- AppendTitle(title, kNoEditBuff);
- SetWTitle(window, title);
- END;
- END;
- END; {CheckTitle}
-
-
- {$S Main}
- PROCEDURE DrawShape (shape: Shapes; VAR extent: Rect);
-
- {Draw the shape specified in the extent. Extent is a VAR
- parameter because the region and polygon are generated
- from the extent rect and the calculations might result
- in a final shape larger than the original extent.}
-
- PROCEDURE DoRegion;
-
- {Generate a region based on the extent.}
-
- VAR
- r : Rect;
- rHandle : RgnHandle;
- pHandle : PolyHandle;
-
- BEGIN
- r := extent;
- rHandle := NewRgn;
- OpenRgn;
-
- FrameRect(extent);
- WITH r DO BEGIN
- top := top + ((bottom - top) DIV 3);
- bottom := top + ((bottom - top) DIV 2);
- END;
- FrameOval(r);
- pHandle := OpenPoly;
- WITH extent DO BEGIN
- MoveTo(left, top);
- LineTo(right, bottom);
- LineTo(left + (right - left) DIV 2, bottom - (bottom - top) DIV 3);
- LineTo(left, top);
- END;
- ClosePoly;
- FramePoly(pHandle);
- KillPoly(pHandle);
-
- CloseRgn(rHandle);
- extent := rHandle^^.rgnBBox; {in case bigger than original rect}
- IF gMac.hasColorQD THEN
- PaintRgn(rHandle)
- ELSE
- FillRgn(rHandle, qd.black);
- ForeColor(blackColor);
- FrameRgn(rHandle);
- DisposeRgn(rHandle);
- END; {DoRegion}
-
- PROCEDURE DoPoly;
-
- {Generate a polygon based on the extent.}
-
- VAR
- pHandle : PolyHandle;
-
- BEGIN
- pHandle := OpenPoly;
- WITH extent DO BEGIN
- MoveTo(left + (right - left) DIV 2, top);
- LineTo(right, bottom);
- LineTo(left, top + (bottom - top) DIV 3);
- LineTo(right, top + (bottom - top) DIV 3);
- LineTo(left, bottom);
- LineTo(left + (right - left) DIV 2, top);
- END;
- ClosePoly;
- extent := pHandle^^.polyBBox; {in case bigger than original rect}
- IF gMac.hasColorQD THEN
- PaintPoly(pHandle)
- ELSE
- FillPoly(pHandle, qd.ltGray);
- ForeColor(blackColor);
- FramePoly(pHandle);
- KillPoly(pHandle);
- END; {DoPoly}
-
- BEGIN
- PenNormal;
- PenSize(kFramePenH, kFramePenV);
- CASE shape OF
- kOval: BEGIN
- IF gMac.hasColorQD THEN
- PaintOval(extent)
- ELSE
- FillOval(extent, qd.white);
- ForeColor(blackColor);
- FrameOval(extent);
- END;
- kRegion:
- DoRegion;
- kRRect: BEGIN
- IF gMac.hasColorQD THEN
- PaintRoundRect(extent, 16, 16)
- ELSE
- FillRoundRect(extent, 16, 16, qd.gray);
- ForeColor(blackColor);
- FrameRoundRect(extent, 16, 16);
- END;
- kPoly:
- DoPoly;
- kRect: BEGIN
- IF gMac.hasColorQD THEN
- PaintRect(extent)
- ELSE
- FillRect(extent, qd.dkGray);
- ForeColor(blackColor);
- FrameRect(extent);
- END;
- kICON:
- IF gMac.hasColorQD THEN
- PlotCIcon(extent, gcicn)
- ELSE BEGIN
- HLock(Handle(gcicn));
- WITH gcicn^^ DO BEGIN
- {We cannot call PlotCIcon when Color QD is not
- present, but we can still use the color icon
- data.}
- iconMask.baseAddr := @iconMaskData;
- iconBMap.baseAddr := Ptr(ORD(@iconMaskData) + 128);
- CopyMask(iconBMap, iconMask, qd.thePort^.portBits,
- iconBMap.bounds, iconMask.bounds, extent);
- END;
- HUnlock(Handle(gcicn));
- END;
- kPICT:
- DrawPicture(gPICT, extent);
- END;
- END; {DrawShape}
-
-
- {$S Main}
- FUNCTION GimmeBlackAndWhite(rgb: RGBColor; VAR position: LONGINT): BOOLEAN;
-
- {This is a search proc that returns white only if the color is really white;
- otherwise it returns black. It is used to generate the mask for the color
- cursor. It boldly assumes that it is being called for a 1 bit deep map.}
-
- BEGIN
- WITH rgb DO
- IF (red = $FFFF) & (green = $FFFF) & (blue = $FFFF) THEN
- position := 0 {return white if it’s white}
- ELSE
- position := 1; {else return black for all other colors}
- GimmeBlackAndWhite := TRUE;
- END; {GimmeBlackAndWhite}
-
-
- {$S Main}
- PROCEDURE SetObjCursor (window: WindowPtr);
-
- {Build the color cursor. Note that this routine is only called
- in a Color QD environment, so it doesn't have to make the
- check. Note also that the cursors could have all been 'pre-
- built', thus making things more efficient, but this example
- shows that dynamic cursors can be implemented via pixmaps.}
-
- VAR
- colors : CTabHandle;
- pal : PaletteHandle;
- rgb : RGBColor;
- bounder, extent : Rect;
- buffNotNeeded : BOOLEAN;
- naughtyBits : BitMap;
- oneBitPMap : BitMapPtr;
-
- BEGIN
- SetRect(bounder, 0, 0, 16, 16);
- pal := GetPalette(window);
- GetEntryColor(pal, ORD(gShape) + 2, rgb); {get the color used for the shape}
-
- DisposeOffscreen(gOughHandle); {get rid of old color table}
- colors := CTabHandle(NewHandleClear(SIZEOF(ColorTable)));
- FailNILMsg(colors, eNoMemory);
- colors^^.ctTable[0].rgb := rgb; {stuff in the color we want}
-
- FailOSErr(NewOffscreen(bounder, kCursorDepth, colors,
- NOT kMemoryPolite, buffNotNeeded,
- gOughHandle));
- DisposeHandle(Handle(colors));
-
- HLock(Handle(gCursor));
- WITH gCursor^^ DO BEGIN
- crsrMap := PixMapHandle(RecoverHandle(Ptr(GetMap(gOughHandle))));
- crsrData := GetBitsHandle(gOughHandle);
- IF crsrData = NIL THEN BEGIN {no handle to bits available-punt}
- SetCursor(qd.arrow);
- Exit(SetObjCursor);
- END;
- BeginOffscreenDrawing(gOughHandle, NIL);
- IF NOT (gShape IN [kICON, kPICT]) THEN BEGIN
- SetPt(crsrHotSpot, 0, 0);
- RGBForeColor(rgb);
- extent := bounder;
- InsetRect(extent, 3, 1); {squeeze it a bit}
- DrawShape(gShape, extent); {draw the cursor shape}
- PenNormal;
- ForeColor(blackColor); {draw hot spot}
- MoveTo(0, 0);
- LineTo(0, 1);
- END ELSE BEGIN {use a plain cursor for icon/pict}
- SetPt(crsrHotSpot, 2, 2);
- PenNormal;
- ForeColor(blackColor);
- MoveTo(0, 0);
- LineTo(4, 4);
- MoveTo(4, 0);
- LineTo(0, 4);
- END;
- EndOffscreenDrawing(gOughHandle);
- WITH naughtyBits DO BEGIN {build 1-bit image and mask}
- bounds := bounder;
- baseAddr := @crsr1Data;
- rowBytes := 2;
- CopyBits(BitMapPtr(crsrMap^)^, naughtyBits,
- bounder, bounder, srcCopy, NIL);
-
- oneBitPMap := GetMap(g1BitHandle);
- oneBitPMap^.baseAddr := @crsrMask;
- AddSearch(@GimmeBlackAndWhite);
- CopyBits(BitMapPtr(crsrMap^)^, oneBitPMap^,
- bounder, bounder, srcCopy, NIL);
- DelSearch(@GimmeBlackAndWhite);
- END;
- crsrXValid := 0;
- crsrID := GetCTSeed;
- END;
- HUnlock(Handle(gCursor));
- END; {SetObjCursor}
-
-
- {$S Main}
- FUNCTION GetInvalExtent (window: WindowPtr; shape: Shapes) : Rect;
-
- {Return the shape's extent, adjusted for the pensize of the frame.}
-
- VAR
- r : Rect;
-
- BEGIN
- r := OffscreenPeek(window)^.fShapes[shape].extent;
- WITH r DO BEGIN
- right := right + kFramePenH;
- bottom := bottom + kFramePenV;
- END;
- GetInvalExtent := r;
- END; {GetInvalExtent}
-
-
- {$S Main}
- PROCEDURE ChangeColor (window: WindowPtr);
-
- {Display the Color ColorPicker dialog. Note that this is
- only called in Color QD environments.}
-
- VAR
- pal : PaletteHandle;
- inColor, outColor : RGBColor;
- where : Point;
- r : Rect;
- aString : StringHandle;
- prompt : Str255;
-
- BEGIN
- pal := GetPalette(window);
- WITH OffscreenPeek(window)^ DO BEGIN
- GetEntryColor(pal, ORD(gShape) + 2, inColor);
- SetPt(where, kDILeft, kDITop);
- aString := GetString(kColorPrompt);
- IF aString <> NIL THEN
- prompt := aString^^
- ELSE
- prompt := '';
- IF GetColor(where, prompt, inColor, outColor) THEN BEGIN
- SetEntryColor(pal, ORD(gShape) + 2, outColor);
- ActivatePalette(window);
- SetObjCursor(window);
- IF NOT (fShapes[gShape].next = Shapes(kNotDrawn)) THEN BEGIN
- r := GetInvalExtent(window, gShape);
- SetPort(window);
- InvalRect(r);
- END;
- END;
- END;
- END; {ChangeColor}
-
-
- {$S Main}
- PROCEDURE DoNewWindow;
-
- {We will allocate our own window storage instead of letting the Window
- Manager do it for two reasons. One, GetNewWindow locks the 'WIND' resource
- handle before calling NewWindow and this can lead to heap fragmentation
- in low memory situations. Two, it takes just as much time for NewWindow
- to get the memory as it does for us to get it. Three, there are THREE
- reasons we will allocate our own window storage instead of letting the
- Window Manager do it. One, GetNewWindow locks etc. etc. Two, it takes
- just as much time, etc. etc. And three, this way we can allocate larger records
- where the extra space can be used to connect other, related data structures.
- Four, there is no fourth reason.}
-
- VAR
- p : Ptr;
- window : WindowPtr;
- noBuffsPlease : BOOLEAN;
- title : Str255;
- shape : Shapes;
- emptyRect : Rect;
-
- BEGIN
- p := NewPtr(SIZEOF(OffscreenRecord));
- FailNILMsg(p, eNoMemory);
- window := NIL;
- IF gMac.hasColorQD THEN
- window := GetNewCWindow(rWindow, p, WindowPtr(-1))
- ELSE
- window := GetNewWindow(rWindow, p, WindowPtr(-1));
- FailNILMsg(window, eNoMemory);
-
- WITH OffscreenPeek(window)^ DO BEGIN
- fBackHandle := NIL;
- fEditHandle := NIL;
- fHasBack := FALSE;
- fHasEdit := FALSE;
- IF gUseBack THEN
- IF NewOffscreenForWindow(window, noBuffsPlease, fBackHandle) = noErr THEN;
- IF gUseEdit THEN
- IF NewOffscreenForWindow(window, noBuffsPlease, fEditHandle) = noErr THEN;
- SetRect(emptyRect, 0, 0, 0, 0);
- FOR shape := kOval TO kPICT DO BEGIN
- fShapes[shape].next := Shapes(kNotDrawn);
- fShapes[shape].extent := emptyRect;
- END;
- fFirst := Shapes(kNotDrawn);
- fEdit := Shapes(kNotDrawn);
- END;
-
- CheckTitle(window, FALSE);
- IF gMac.hasColorQD THEN
- SetObjCursor(window);
- END; {DoNewWindow}
-
-
- {$S Initialize}
- PROCEDURE Initialize;
-
- {Set up the whole world, including global variables, Toolbox managers,
- and menus. We also create one application window at this time.
- Since window storage is non-relocateable, how and when to allocate space
- for windows is very important so that heap fragmentation does not occur.
- Window storage can differ widely amongst applications depending on how many
- windows are created and disposed. If a failure occurs here, we will consider
- that the application is in such bad shape that we should just exit. Your error
- handling may differ, but the checks should still be made.}
-
- TYPE
- crsColors = ARRAY[0..2] OF ColorSpec;
-
- VAR
- menuBar : Handle;
- ignoreError : OSErr;
- total, contig : LongInt;
- ignoreResult : BOOLEAN;
- event : EventRecord;
- count : INTEGER;
- fi : FailInfo;
- colors : CTabHandle;
- bounder : Rect;
- buffNotNeeded : BOOLEAN;
-
- PROCEDURE HandleErr(error: INTEGER; message: LongInt);
- BEGIN
- IF error > 0 THEN
- AlertUser(0, error)
- ELSE
- AlertUser(error, message);
- ExitToShell;
- END; {HandleErr}
-
- BEGIN
- gInBackground := FALSE;
-
- InitGraf(@qd.thePort);
- InitFonts;
- InitWindows;
- InitMenus;
- TEInit;
- InitDialogs(NIL);
- InitCursor;
-
- InitOffscreen;
-
- {Call OpenDriver('.MPP', refnum) at this point to initialize AppleTalk,
- if you are using it.}
-
- {NOTE -- It is no longer necessary, and actually unhealthy, to check
- PortBUse and SPConfig before opening AppleTalk. The drivers are capable
- of checking for port availability themselves.}
-
- {This next bit of code is necessary to allow the default button of our
- alert to be outlined.}
-
- FOR count := 1 TO 3 DO
- ignoreResult := EventAvail(everyEvent, event);
-
- CatchFailures(fi, HandleErr);
-
- {Ignore the error returned from SysEnvirons; even if an error occurred,
- the SysEnvirons glue will fill in the SysEnvRec. You can save a redundant
- call to SysEnvirons by calling it after initializing AppleTalk.}
-
- ignoreError := SysEnvirons(kSysEnvironsVersion, gMac);
-
- {Make sure that the machine has at least 128K ROMs. If it doesn't, exit.}
-
- IF gMac.machineType < 0 THEN
- Failure(0, eWrongMachine);
-
- {Move TrapAvailable call to after SysEnvirons so that we can tell
- in TrapAvailable if a tool trap value is out of range.}
-
- gHasWaitNextEvent := TrapAvailable(_WaitNextEvent, ToolTrap);
-
- {First check the size of the application heap against a value
- that you have determined is the smallest heap the application can reasonably
- work in. This number should be derived by examining the size of the heap that
- is actually provided by MultiFinder when the minimum size requested is used.
- The derivation of the minimum size requested from MultiFinder is described
- in Sample.h. The check should be made because the preferred size can end up
- being set smaller than the minimum size by the user. This extra check acts to
- insure that your application is starting from a solid memory foundation.}
-
- IF ORD(GetApplLimit) - ORD(ApplicationZone) < kMinHeap THEN
- Failure(0, eSmallSize);
-
- {Next, make sure that enough memory is free for your application to run. It
- is possible for a situation to arise where the heap may have been of required
- size, but a large scrap was loaded which left too little memory. To check for
- this, call PurgeSpace and compare the result with a value that you have determined
- is the minimum amount of free memory your application needs at initialization.
- This number can be derived several different ways. One way that is fairly
- straightforward is to run the application in the minimum size configuration
- as described previously. Call PurgeSpace at initialization and examine the value
- returned. However, you should make sure that this result is not being modified
- by the scrap's presence. You can do that by calling ZeroScrap before calling
- PurgeSpace. Make sure to remove that call before shipping, though.}
-
- PurgeSpace(total, contig);
- IF total < kMinSpace THEN
- Failure(0, eNoMemory);
-
- {The extra benefit to waitng until after the Toolbox Managers have been initialized
- before checking memory is that we can now give the user an alert to tell him what
- happened. Although it is possible that the memory situation could be worsened by
- displaying an alert, MultiFinder would gracefully exit the application with
- an informative alert if memory became critical. Here we are acting more
- in a preventative manner to avoid future disaster from low-memory problems.}
-
- menuBar := GetNewMBar(rMenuBar); {read menus into menu bar}
- FailNILMsg(menuBar, eNoMemory);
- SetMenuBar(menuBar); {install menus}
- DisposeHandle(menuBar);
- AppendResMenu(GetMenuHandle(mApple), 'DRVR'); {add DA names to Apple menu}
- DrawMenuBar;
- gShape := kOval;
- gUseBack := TRUE;
- gUseEdit := TRUE;
- gOughHandle := NIL;
-
- {Get the 'Moof' icon. If the environment supports Color QD,
- we'll get the color icon. If Color QD is not supported,
- we'll still get the color icon, but use it differently.}
-
- IF gMac.hasColorQD THEN BEGIN
- gcicn := GetCIcon(kCMoof);
- FailNILMsg(gcicn, eNoMemory);
- END ELSE BEGIN
- gcicn := CIconHandle(GetResource('cicn', kCMoof));
- FailNILMsg(gcicn, eNoMemory);
- END;
-
- {If Color QD is supported, we'll get an 8-bit PICT of
- Gigantor. If it isn't supported, we'll get a PICT
- that looks better in non-color ports/}
-
- IF gMac.hasColorQD THEN
- gPICT := GetPicture(kGigantor)
- ELSE
- gPICT := GetPicture(k1bitGigantor);
- FailNILMsg(gPICT, eNoMemory);
-
- {If Color QD is supported, we'll set up a color cursor
- that will be modified later. Otherwise, nothing
- happens. We'll also set up a 1-bit offscreen to
- make a cursor mask.}
-
- IF gMac.hasColorQD THEN BEGIN
- gCursor := CCrsrHandle(NewHandleClear(SIZEOF(CCrsr)));
- FailNILMsg(gCursor, eNoMemory);
- MoveHHi(Handle(gCursor));
- HLock(Handle(gCursor));
- WITH gCursor^^ DO BEGIN
- crsrType := $8001;
- crsrXData := NewHandle(0);
- END;
- HUnlock(Handle(gCursor));
- colors := CTabHandle(NewHandleClear(SIZEOF(ColorTable)));
- FailNILMsg(colors, eNoMemory);
- SetRect(bounder, 0, 0, 16, 16);
-
- {For this one bit deep offscreen guy (used to make cursor masks)
- we pass in a zeroed but otherwise unitialized color table. Since
- the map’s ctable will only have B&W anyway, it doesn’t matter.}
-
- FailOSErr(NewOffscreen(bounder, 1, colors,
- NOT kMemoryPolite, buffNotNeeded,
- g1BitHandle));
- DisposeHandle(Handle(colors));
- END;
-
- DoNewWindow; {create a new window right away}
- END; {Initialize}
-
-
- {$S Main}
- PROCEDURE Terminate;
-
- {Clean up the application and exits. We close all of the windows so that
- they can update their documents, if any.
- If we find out that a cancel has occurred, we won't exit to the
- shell, but will return instead.}
-
- VAR
- aWindow : WindowPtr;
- closed : BOOLEAN;
-
- BEGIN
- closed := TRUE;
- REPEAT
- aWindow := FrontWindow; {get the current front window}
- IF aWindow <> NIL THEN
- closed := DoCloseWindow(aWindow); {close this window}
- UNTIL (NOT closed) | (aWindow = NIL); {do all windows}
- IF closed THEN
- ExitToShell; {exit if no cancellation}
- END; {Terminate}
-
-
- {$S Main}
- PROCEDURE AdjustMenus;
-
- {Enable and disable menus based on the current state.
- The user can only select enabled menu items. We set up all the menu items
- before calling MenuSelect or MenuKey, since these are the only times that
- a menu item can be selected. Note that MenuSelect is also the only time
- the user will see menu items. This approach to deciding what enable/
- disable state a menu item has the advantage of concentrating all the decision-
- making in one routine, as opposed to being spread throughout the application.
- Other application designs may take a different approach that may or may not be
- just as valid.}
-
- VAR
- window : WindowPtr;
- menu : MenuHandle;
-
- BEGIN
- window := FrontWindow;
-
- menu := GetMenuHandle(mFile);
- IF IsDAWindow(window) |
- IsAppWindow(window) THEN {we can allow DAs to be closed from the menu}
- EnableItem(menu, iClose)
- ELSE
- DisableItem(menu, iClose);
-
- menu := GetMenuHandle(mEdit);
- IF IsDAWindow(window) THEN BEGIN {a desk accessory might need the edit menu}
- EnableItem(menu, iUndo);
- EnableItem(menu, iCut);
- EnableItem(menu, iCopy);
- EnableItem(menu, iPaste);
- EnableItem(menu, iClear);
- END ELSE BEGIN {but we know we do not}
- DisableItem(menu, iUndo);
- DisableItem(menu, iCut);
- DisableItem(menu, iCopy);
- DisableItem(menu, iClear);
- DisableItem(menu, iPaste);
- END;
-
- menu := GetMenuHandle(mSpecial);
- IF gMac.hasColorQD & IsAppWindow(window) THEN
- EnableItem(menu, iPickColor) {color can change only if we are top}
- ELSE
- DisableItem(menu, iPickColor);
- END; {AdjustMenus}
-
-
- {$S Main}
- PROCEDURE DoMenuCommand(menuResult: LONGINT);
-
- {This is called when an item is chosen from the menu bar (after calling
- MenuSelect or MenuKey). It performs the right operation for each command.
- It is good to have both the result of MenuSelect and MenuKey go to
- one routine like this to keep everything organized.}
-
- VAR
- menuID : INTEGER; {the resource ID of the selected menu}
- menuItem : INTEGER; {the item number of the selected menu}
- int : INTEGER;
- str : Str255;
- ignore : BOOLEAN;
-
- BEGIN
- menuID := HiWord(menuResult); {use built-ins (for efficiency)...}
- menuItem := LoWord(menuResult); {to get menu item number and menu number}
- CASE menuID OF
- mApple:
- CASE menuItem OF
- iAbout: {bring up alert for About}
- int := Alert(rAboutAlert, NIL);
- OTHERWISE BEGIN {all non-About items in this menu are DAs}
- GetMenuItemText(GetMenuHandle(mApple), menuItem, str);
- int := OpenDeskAcc(str);
- END;
- END;
- mFile:
- CASE menuItem OF
- iNew:
- DoNewWindow;
- iClose:
- ignore := DoCloseWindow(FrontWindow); {we don't care if cancelled}
- iQuit:
- Terminate;
- END;
- mEdit: {call SystemEdit for DA editing & MultiFinder}
- ignore := SystemEdit(menuItem-1); {since we don't do any editing}
- mShape:
- IF gShape <> Shapes(menuItem - 1) THEN BEGIN
- CheckItem(GetMenuHandle(mShape), ORD(gShape) + 1, FALSE);
- gShape := Shapes(menuItem - 1); {the shape is the item}
- CheckItem(GetMenuHandle(mShape), ORD(gShape) + 1, TRUE);
- IF gMac.hasColorQD & IsAppWindow(FrontWindow) THEN
- SetObjCursor(FrontWindow);
- END;
- mSpecial:
- CASE menuItem OF
- iUseBack: BEGIN
- gUseBack := NOT gUseBack;
- CheckItem(GetMenuHandle(mSpecial), iUseBack, gUseBack);
- END;
- iUseEdit: BEGIN
- gUseEdit := NOT gUseEdit;
- CheckItem(GetMenuHandle(mSpecial), iUseEdit, gUseEdit);
- END;
- iPickColor:
- ChangeColor(FrontWindow);
- END;
- END;
- HiliteMenu(0); {unhighlight what MenuSelect (or MenuKey) hilited}
- END; {DoMenuCommand}
-
-
- {$S Main}
- PROCEDURE GoThroughShapes (PROCEDURE WhatToDo(shape: Shapes); window: WindowPtr);
-
- {Go through the list of shapes for window and
- call WhatToDo, passing the shape we are on
- each time.}
-
- VAR
- theShape : Shapes;
-
- BEGIN
- WITH OffscreenPeek(window)^ DO
- IF ORD(fFirst) <> kNotDrawn THEN BEGIN
- theShape := fFirst;
- REPEAT
- WhatToDo(theShape);
- theShape := fShapes[theShape].next;
- UNTIL ORD(theShape) = kLastOne;
- END;
- END; {GoThroughShapes}
-
-
- {$S Main}
- PROCEDURE DrawAllShapes (window: WindowPtr; doEdit: BOOLEAN);
-
- {Draw either the currently edited shape or all the shapes
- in the window's list. Called by DrawWindow.}
-
- VAR
- area : Rect;
-
- PROCEDURE AndDrawThem (shape: Shapes);
-
- VAR
- r : Rect;
-
- BEGIN
- WITH OffscreenPeek(window)^ DO
- IF shape <> fEdit THEN BEGIN
- IF SectRect(OffscreenPeek(window)^.fShapes[shape].extent, area, r)
- THEN BEGIN
- IF gMac.hasColorQD THEN
- PmForeColor(ORD(shape) + 2);
- DrawShape(shape, OffscreenPeek(window)^.fShapes[shape].extent);
- END;
- END;
- END;
-
- BEGIN
- SetPort(window);
- IF doEdit THEN BEGIN
- WITH OffscreenPeek(window)^ DO {draw edit shape}
- IF ORD(fEdit) <> kNotDrawn THEN BEGIN
- IF gMac.hasColorQD THEN
- PmForeColor(ORD(fEdit) + 2);
- DrawShape(fEdit, OffscreenPeek(window)^.fShapes[fEdit].extent);
- END;
- END ELSE BEGIN
- area := window^.visRgn^^.rgnBBox;
- GoThroughShapes(AndDrawThem, window);
- END;
- END; {DrawAllShapes}
-
-
- {$S Main}
- PROCEDURE DrawWindow(window: WindowPtr);
-
- {The core application window updating routine. Understands about Offscreen
- setup, (in this case, two nested offscreen buffers), and what needs to
- be drawn, in this case, a whole bunch of shapes. Called from two routines,
- DoUpdate and DoContentClick. The way it works is first, by calling
- BeginUpdateOffscreen on fEditHandle, the drawing is redirected to
- the 'edit' offscreen pixmap. Next, if any drawing needs to be done
- in the 'background' pixmap, then by calling BeginOffscreenDrawing on
- fBackHandle, drawing is further redirected. All the shapes that exist
- but are not the one being edited (i.e., the background) are drawn here
- and the EndOffscreenDrawing causes the redirecting to cease. Then the
- pixmap is copybitsed into the next outer layer of drawing, whether that
- is the 'edit' offscreen pixmap or the window itself. There, the shape
- being edited is drawn. Finally, EndUpdateOffscreen is called to cease
- that layer of redirection and copybits the 'edit' offscreen to the window.
- The way this is designed, it all still works if either or both of the
- offscreen pixmaps is missing.}
-
- VAR
- globalRect : Rect;
- drawNeeded : BOOLEAN;
- backMap : BitMapPtr;
-
- BEGIN
- GetGlobalRect(window, globalRect);
- WITH OffscreenPeek(window)^ DO BEGIN
- IF CheckBoundsOffscreen(fEditHandle, globalRect, drawNeeded) <> noErr THEN {do nada};
- SetPort(window);
- BeginUpdateOffscreen(fEditHandle, window); {this sets up the visRgn}
-
- IF CheckBoundsOffscreen(fBackHandle, globalRect, drawNeeded) <> noErr THEN
- {do nada};
- IF drawNeeded THEN BEGIN {draw if updating needs to be done}
- BeginOffscreenDrawing(fBackHandle, window);
- EraseRect(window^.portRect); {clear out any garbage that might}
- DrawAllShapes(window, FALSE); {be left behind and draw the}
- EndOffscreenDrawing(fBackHandle); {'background'}
- END;
- backMap := GetMap(fBackHandle);
- IF backMap <> NIL THEN BEGIN
- ForeColor(blackColor);
- BackColor(whiteColor); {so funny colorization doesn't happen}
- WITH window^ DO BEGIN
- CopyBits(backMap^, portBits, portRect, portRect, srcCopy, NIL);
- ValidRectOffscreen(fBackHandle, NIL, portRect);
- END;
- END;
- DrawAllShapes(window, TRUE); {only draw the edited shape}
-
- EndUpdateOffscreen(fEditHandle, window);
- CheckTitle(window, TRUE); {buffers may have changed}
- END;
- END; {DrawWindow}
-
-
- {$S Main}
- PROCEDURE DoContentClick (window: WindowPtr; event: EventRecord);
-
- {This is called when a mouse-down event occurs in the content of a window.
- Other applications might want to call FindControl, TEClick, etc., to
- further process the click. In Offsample, a user click in the content
- region means a shape is to be added or changed.}
-
- VAR
- oldRect, newRect : Rect;
- anchorPt, oldPt, nextPt : Point;
- lastShape : Shapes;
- first : BOOLEAN;
-
- PROCEDURE AndReorderThem (shape: Shapes);
-
- {Remove the edited shape from the linked list of shapes.}
-
- BEGIN
- WITH OffscreenPeek(window)^ DO
- IF shape <> gShape THEN
- lastShape := shape
- ELSE
- IF fFirst = shape THEN
- fFirst := fShapes[shape].next
- ELSE
- fShapes[lastShape].next := fShapes[shape].next;
- END; {AndReorderThem}
-
- BEGIN
- IF IsAppWindow(window) THEN
- WITH OffscreenPeek(window)^ DO BEGIN
- anchorPt := event.where;
- GlobalToLocal(anchorPt);
- oldPt := anchorPt;
-
- {If the shape being edited existed previously, we need
- to invalidate its old position so that it gets
- 'erased'.}
-
- IF ORD(fShapes[gShape].next) <> kNotDrawn THEN BEGIN
- oldRect := GetInvalExtent(window, gShape);
- InvalRectOffscreen(fBackHandle, NIL, oldRect);
- InvalRectOffscreen(fEditHandle, window, oldRect);
- END;
- fEdit := gShape; {flag this shape as edited}
- lastShape := Shapes(kLastOne);
- GoThroughShapes(AndReorderThem, window);
- IF ORD(lastShape) <> kLastOne THEN
- fShapes[lastShape].next := gShape {make edited shape last}
- ELSE
- fFirst := gShape; {or if only shape, first}
- fShapes[gShape].next := Shapes(kLastOne);
- Pt2Rect(anchorPt, anchorPt, oldRect);
- first := TRUE; {indicate first time though loop}
- WHILE WaitMouseUp DO BEGIN {while the mouse is down…}
- GetMouse(nextPt);
- IF first | (NOT EqualPt(oldPt, nextPt)) THEN BEGIN
- first := FALSE; {no longer first time through loop}
- oldPt := nextPt;
- CASE gShape OF
- kOval, {build a rectangle for these}
- kRegion, {from the anchor point and}
- kRRect, {the current point}
- kPoly,
- kRect:
- Pt2Rect(anchorPt, nextPt, newRect);
- kICON: {rect from current position}
- WITH nextPt, newRect DO BEGIN
- top := v;
- left := h;
- bottom := top + 32;
- right := left + 32;
- END;
- kPICT: {rect from current position}
- WITH nextPt, newRect DO BEGIN
- newRect := gPICT^^.picFrame;
- OffsetRect(newRect, -left, -top);
- OffsetRect(newRect, h, v);
- END;
- END;
- fShapes[gShape].extent := newRect;
- UnionRect(newRect, oldRect, oldRect);
-
- {In the case of the 'stretchable' shapes whose extents are
- built from the anchor point and the current point, doing
- a UnionRect is pretty close to being as efficient as doing
- a UnionRgn with two regions that are shaped like the old
- and new extents. However, a case can be made for using
- regions for the icon and the picture since they move around
- instead of 'stretching'. The effect of extra, unnecessary
- invalidation is, of course, most noticeable when there is
- no edit offscreen and the icon/picture is moved around
- rapidly. Changing the code to use regions is LEFT AS AN
- EXERCISE FOR THE READER, Ha-Ha-Ha.}
-
- InvalRectOffscreen(fEditHandle, window, oldRect);
- DrawWindow(window);
- oldRect := GetInvalExtent(window, gShape);
- END;
- END;
- fEdit := Shapes(kNotDrawn);
- oldRect := GetInvalExtent(window, gShape);
- InvalRectOffscreen(fBackHandle, NIL, oldRect);
- END;
- END; {DoContentClick}
-
-
- {$S Main}
- PROCEDURE DoUpdate(window: WindowPtr);
-
- {This is called when an update event is received for a window.
- It calls DrawWindow to draw the contents of an application window.}
-
- BEGIN
- IF IsAppWindow(window) THEN
- DrawWindow(window);
- END; {DoUpdate}
-
-
- {$S Main}
- PROCEDURE DoActivate(window: WindowPtr; becomingActive: BOOLEAN);
-
- {This is called when a window is activated or deactivated.}
-
- BEGIN
- IF IsAppWindow(window) THEN
- IF gMac.hasColorQD & becomingActive THEN
- SetObjCursor(window);
- END; {DoActivate}
-
-
- {$S Main}
- PROCEDURE AdjustCursor(region: RgnHandle);
-
- {Change the cursor's shape, depending on its position. This also calculates the region
- where the current cursor resides (for WaitNextEvent). If the mouse is ever outside of
- that region, an event is generated, causing this routine to be called. This
- allows us to change the region to the region the mouse is currently in. If
- there is more to the event than just “the mouse moved”, we get called before the
- event is processed to make sure the cursor is the right one. In any (ahem) event,
- this is called again before we fall back into WNE.}
-
- VAR
- window : WindowPtr;
- arrowRgn : RgnHandle;
- shapeRgn : RgnHandle;
- globalPortRect : Rect;
- mouse : Point;
-
- BEGIN
- window := FrontWindow;
- {we only adjust the cursor when we are in front}
- IF (NOT gInBackground) AND (NOT IsDAWindow(window)) THEN BEGIN
- GetMouse(mouse);
- LocalToGlobal(mouse);
-
- {calculate regions for different cursor shapes}
- arrowRgn := NewRgn;
- shapeRgn := NewRgn;
-
- {start with a big, big rectangular region}
- SetRectRgn(arrowRgn, kExtremeNeg, kExtremeNeg,
- kExtremePos, kExtremePos);
-
- {calculate shapeRgn}
- IF IsAppWindow(window) THEN BEGIN
- SetPort(window); {make a global version of the portRect}
- IF gMac.hasColorQD THEN
- WITH CGrafPtr(window)^ DO
- SetOrigin(-portPixMap^^.bounds.left, -portPixMap^^.bounds.top)
- ELSE
- WITH window^.portBits.bounds DO
- SetOrigin(-left, -top);
- globalPortRect := window^.portRect;
- RectRgn(shapeRgn, globalPortRect);
- SectRgn(shapeRgn, window^.visRgn, shapeRgn);
- SetOrigin(0, 0);
- END;
-
- {subtract other regions from arrowRgn}
- DiffRgn(arrowRgn, shapeRgn, arrowRgn);
-
- {change the cursor and the region parameter}
- IF PtInRgn(mouse, shapeRgn) THEN BEGIN
- IF gMac.hasColorQD THEN
- SetCCursor(gCursor)
- ELSE
- SetCursor(GetCursor(crossCursor)^^);
- CopyRgn(shapeRgn, region);
- END ELSE BEGIN
- SetCursor(qd.arrow);
- CopyRgn(arrowRgn, region);
- END;
-
- {get rid of our local regions}
- DisposeRgn(arrowRgn);
- DisposeRgn(shapeRgn);
- END;
- END; {AdjustCursor}
-
-
- {$S Main}
- PROCEDURE DoEvent(event: EventRecord);
-
- {Do the right thing for an event. Determine what kind of event it is, and call
- the appropriate routines.}
-
- VAR
- part, err : INTEGER;
- window : WindowPtr;
- ignore : BOOLEAN;
- key : CHAR;
- aPoint : Point;
- fi : FailInfo;
-
- PROCEDURE HandleErr(error: INTEGER; message: LongInt);
- BEGIN
- IF error > 0 THEN
- AlertUser(0, error)
- ELSE
- AlertUser(error, message);
- EXIT(DoEvent);
- END; {HandleErr}
-
- BEGIN
- CatchFailures(fi, HandleErr);
- CASE event.what OF
- mouseDown: BEGIN
- part := FindWindow(event.where, window);
- CASE part OF
- inMenuBar: BEGIN {process the menu command}
- AdjustMenus;
- DoMenuCommand(MenuSelect(event.where));
- END;
- inSysWindow: {let the system handle the mouseDown}
- SystemClick(event, window);
- inContent:
- IF window <> FrontWindow THEN BEGIN
- SelectWindow(window);
- {DoEvent(event);} {use this line for "do first click"}
- END ELSE
- DoContentClick(window, event);
- inDrag: {pass screenBits.bounds to get all gDevices}
- DragWindow(window, event.where, qd.screenBits.bounds);
- inGrow:;
- inZoomIn, inZoomOut:;
- inGoAway:
- IF TrackGoAway(window, event.where) THEN
- ignore := DoCloseWindow(window);
- END;
- END;
- keyDown, autoKey: BEGIN {check for menukey equivalents}
- key := CHR(BAnd(event.message, charCodeMask));
- IF BAnd(event.modifiers, cmdKey) <> 0 THEN {Command key down}
- IF event.what = keyDown THEN BEGIN
- AdjustMenus; {enable/disable/check menu items properly}
- DoMenuCommand(MenuKey(key));
- END;
- END; {call DoActivate with the window and...}
- activateEvt: {TRUE for activate, FALSE for deactivate}
- DoActivate(WindowPtr(event.message), BAnd(event.modifiers, activeFlag) <> 0);
- updateEvt: {call DoUpdate with the window to update}
- DoUpdate(WindowPtr(event.message));
- diskEvt:
- IF HiWord(event.message) <> noErr THEN BEGIN
- SetPt(aPoint, kDILeft, kDITop);
- err := DIBadMount(aPoint, event.message);
- END;
- kOSEvent:
- CASE BAnd(BRotL(event.message, 8), $FF) OF {high byte of message}
- kSuspendResumeMessage: BEGIN
- gInBackground := BAnd(event.message, kResumeMask) = 0;
- DoActivate(FrontWindow, NOT gInBackground);
- END;
- END;
- END;
- Success(fi);
- END; {DoEvent}
-
-
- {$S Main}
- PROCEDURE EventLoop;
-
- {Get events forever, and handle them by calling DoEvent.
- Get the events by calling WaitNextEvent, if it's available, otherwise
- by calling GetNextEvent. Also call AdjustCursor each time through the loop.}
-
- VAR
- cursorRgn : RgnHandle;
- gotEvent : BOOLEAN;
- event : EventRecord;
-
- BEGIN
- cursorRgn := NewRgn; {we’ll pass WNE an empty region the 1st time thru}
- REPEAT
- IF gHasWaitNextEvent THEN {put us 'asleep' forever under MultiFinder}
- gotEvent := WaitNextEvent(everyEvent, event, MAXLONGINT, cursorRgn)
- ELSE BEGIN
- SystemTask; {must be called if using GetNextEvent}
- gotEvent := GetNextEvent(everyEvent, event);
- END;
- IF gotEvent THEN BEGIN
- AdjustCursor(cursorRgn); {make sure we have the right cursor}
- DoEvent(event);
- END;
- AdjustCursor(cursorRgn);
- UNTIL FALSE; {loop forever; we quit through an ExitToShell}
- END; {EventLoop}
-
-
- PROCEDURE _DataInit; EXTERNAL;
-
- {This routine is part of the MPW runtime library. This external
- reference to it is done so that we can unload its segment, %A5Init.}
-
- {$S Main}
- BEGIN
- UnloadSeg(@_DataInit); {note that _DataInit must not be in Main!}
-
- MoreMasters;
- MoreMasters;
- MoreMasters; {prepare for handles used by Offscreen}
-
- {If you have stack requirements that differ from the default,
- then you could use SetApplLimit to increase StackSpace at
- this point, before calling MaxApplZone.}
-
- MaxApplZone; {expand the heap so code segments load at the top}
-
- InitSignals;
- Initialize; {initialize the program}
- UnloadSeg(@Initialize); {note that Initialize must not be in Main!}
-
- EventLoop; {call the main event loop}
- END.
-